home *** CD-ROM | disk | FTP | other *** search
/ Revista CD Expert 13 / CD Expert nº 13.iso / tim30 / wing / msregdb.in_ / msregdb.in
Text File  |  1994-06-26  |  4KB  |  128 lines

  1. '***************************************************************************
  2. '****************     registration database api's    ***********************
  3. '***************************************************************************
  4.  
  5. '$DEFINE REG_DB_ENABLED
  6.  
  7. const REG_SZ               = 1
  8. const HKEY_CLASSES_ROOT    = 1
  9. const ERROR_SUCCESS        = 0
  10.  
  11.  
  12. DECLARE FUNCTION EercErrorHandler LIB "mscomstf.dll" (grc%, fVital%, sz1$, sz2$, sz3$) AS INTEGER
  13. CONST GRC_API_FAILED       = 104
  14.  
  15. DECLARE FUNCTION RegOpenKey LIB "SHELL.DLL" (hKey&, szSubKey$, phkResult AS POINTER TO LONG) AS LONG
  16. DECLARE FUNCTION RegCreateKey LIB "shell.dll" (hKey&, szSubKey$, phkResult AS POINTER TO LONG) AS LONG
  17. DECLARE FUNCTION RegDeleteKey LIB "shell.dll" (hKey&, szSubKey$) AS LONG
  18. DECLARE FUNCTION RegCloseKey LIB "shell.dll" (hKey&) AS LONG
  19. DECLARE FUNCTION RegQueryValue LIB "shell.dll" (hKey&, szSubKey$, szValue$, lpcb AS POINTER TO LONG) AS LONG
  20. DECLARE FUNCTION RegSetValue LIB "shell.dll" (hKey&, szSubKey$, dwType&, szValue$, cbValue&) AS LONG
  21. DECLARE FUNCTION RegEnumKey LIB "shell.dll" (HkEY&, dwIndex&, szBuffer$, dwBufferSize&) AS LONG
  22.  
  23.  
  24. DECLARE SUB CreateRegKey(szKey$)
  25. DECLARE SUB CreateRegKeyValue(szKey$, szValue$)
  26. DECLARE SUB SetRegKeyValue(szKey$, szValue$)
  27. DECLARE SUB DeleteRegKey(szKey$)
  28. DECLARE FUNCTION GetRegKeyValue(szKey$) AS STRING
  29. DECLARE FUNCTION DoesRegKeyExist(szKey$) AS INTEGER
  30.  
  31.  
  32. 'NOTE: All keys are assumed to be subkeys of HKEY_CLASSES_ROOT. Therefore,
  33. 'the key HKEY_CLASSES_ROOT\key1\key2 would simply be written as key1\key2
  34. 'for these api's.
  35.  
  36.  
  37. '**************************************************************************
  38. SUB CreateRegKey(szKey$) STATIC
  39.     DIM phKey AS LONG
  40.  
  41.     IF RegCreateKey(HKEY_CLASSES_ROOT, szKey$, VARPTR(phKey)) > ERROR_SUCCESS THEN
  42.         i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKey", NULL, NULL)
  43. '$ifdef DEBUG
  44.         StfApiErr saeFail, "CreateRegKey", szKey$
  45. '$endif ''DEBUG
  46.         ERROR STFERR
  47.     END IF
  48.  
  49.     IF RegCloseKey(phKey) > ERROR_SUCCESS THEN
  50.         i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKey", NULL, NULL)
  51. '$ifdef DEBUG
  52.         StfApiErr saeFail, "CreateRegKey", szKey$
  53. '$endif ''DEBUG
  54.         ERROR STFERR
  55.     END IF
  56. END SUB
  57.  
  58.  
  59. '**************************************************************************
  60. SUB CreateRegKeyValue(szKey$, szValue$) STATIC
  61.     DIM phKey AS LONG
  62.  
  63.     IF RegSetValue(HKEY_CLASSES_ROOT, szKey$, REG_SZ,  szValue$, len(szKey$)) > ERROR_SUCCESS THEN
  64.         i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKeyValue", NULL, NULL)
  65. '$ifdef DEBUG
  66.         StfApiErr saeFail, "CreateRegKeyValue", szKey$+", "+szValue$
  67. '$endif ''DEBUG
  68.         ERROR STFERR
  69.     END IF
  70. END SUB
  71.  
  72.  
  73. '**************************************************************************
  74. FUNCTION DoesRegKeyExist(szKey$) STATIC AS INTEGER
  75.     DIM phKey AS LONG
  76.  
  77.     IF RegOpenKey(HKEY_CLASSES_ROOT, szKey$, VARPTR(phKey)) = ERROR_SUCCESS THEN
  78.         i = RegCloseKey(phKey)
  79.         DoesRegKeyExist = 1
  80.     ELSE
  81.         DoesRegKeyExist = 0
  82.     ENDIF
  83. END FUNCTION
  84.  
  85.  
  86. '**************************************************************************
  87. SUB SetRegKeyValue(szKey$, szValue$) STATIC
  88.     DIM phKey AS LONG
  89.  
  90.     IF RegSetValue(HKEY_CLASSES_ROOT, szKey$, REG_SZ,  szValue$, len(szKey$)) > ERROR_SUCCESS THEN
  91.         i% = EercErrorHandler(GRC_API_FAILED, 1, "SetRegKeyValue", NULL, NULL)
  92. '$ifdef DEBUG
  93.         StfApiErr saeFail, "SetRegKeyValue", szKey$+", "+szValue$
  94. '$endif ''DEBUG
  95.         ERROR STFERR
  96.     END IF
  97. END SUB
  98.  
  99.  
  100. '**************************************************************************
  101. FUNCTION GetRegKeyValue(szKey$) STATIC AS STRING
  102.     szValue$ = string$(512,32)
  103.     cb& = len(szValue$)
  104.  
  105.     IF DoesRegKeyExist(szKey$) = 0 THEN
  106.         GetRegKeyValue = ""
  107.         EXIT FUNCTION
  108.     END IF
  109.  
  110.     IF RegQueryValue(HKEY_CLASSES_ROOT, szKey$, szValue$, VARPTR(cb)) = ERROR_SUCCESS THEN
  111.         GetRegKeyValue = MID$(szValue$, 1, cb)
  112.     ELSE
  113.         i% = EercErrorHandler(GRC_API_FAILED, 1, "SetRegKeyValue", NULL, NULL)
  114. '$ifdef DEBUG
  115.         StfApiErr saeFail, "GetRegKeyValue", szKey$
  116. '$endif ''DEBUG
  117.         ERROR STFERR
  118.     END IF
  119.     szValue$ = ""
  120. END FUNCTION
  121.  
  122.  
  123. '**************************************************************************
  124. SUB DeleteRegKey(szKey$) STATIC
  125.     i& = RegDeleteKey(HKEY_CLASSES_ROOT, szKey$)
  126. END SUB
  127.  
  128.